home *** CD-ROM | disk | FTP | other *** search
/ Computer Music 2004 January / Computer Music Magazine 68 2004.iso / pc / Software / PC Software / Demo Software / Actinic Audio Store / Audio.exe / CatalogInstaller.EXE / AccountsScript.pl next >
Encoding:
Perl Script  |  2000-07-26  |  12.5 KB  |  414 lines
  1. #!NETQUOTEVAR:PERLPATH
  2. #######################################################
  3. #                                                     #
  4. # The above is the Path to Perl on the ISP's server   #
  5. #                                                     #
  6. # Requires Perl version 5.0 or later                  #
  7. # Requires Perl MD5 module                            #
  8. #                                                     #
  9. #######################################################
  10.  
  11.  
  12. #######################################################
  13. #                                                     #
  14. # PROBLEM SOLVING                                     #
  15. #                                                     #
  16. # Listed below are the most common reasons why this   #
  17. # script may fail to operate correctly:               #
  18. #                                                     #
  19. # This cgi script MUST be installed in the 'CGI-BIN'  #
  20. # directory allocated to the user on server of the    #
  21. # Internet Service Provider.                          #
  22. #                                                     #
  23. # The script MUST be uploaded to this directory as    #
  24. # an ASCII file. Do NOT use the 'AUTO' option in your #
  25. # FTP program for the type of file upload . We have   #
  26. # found that some of these FTP programs default to an #
  27. # incorrect upload format.                            #
  28. #                                                     #
  29. # If you receive any error messages from the server,  #
  30. # usually with an error code of 500 or 501, then the  #
  31. # cause will usually be that this file has been sent  #
  32. # to the server using the wrong transfer mode. To     #
  33. # this please re-upload this file as an ASCII file.   #
  34. #                                                     #
  35. # The file permissions need to be correctly set on    #
  36. # this file when it is installed on UNIX servers.     #
  37. # These permissions need to be set as 'rwx r-x r-x'   #
  38. # which equates to a file mask of '755'. These can    #
  39. # usually be easily set via your FTP program.         #
  40. #                                                     #
  41. # Perl MD5 module must be installed at the ISP site   #
  42. # and must be accessible by this script.              #
  43. #                                                     #
  44. #######################################################
  45.  
  46. #?use CGI::Carp qw(fatalsToBrowser);
  47.  
  48. #
  49. # Make sure "." is included in the @INC directory list so we can find our packages
  50. #
  51. my $bFound = 0;
  52. my $sDir;
  53. foreach $sDir (@INC)
  54.     {
  55.     if ($sDir eq ".")
  56.         {
  57.         $bFound = 1;
  58.         last;
  59.         }
  60.     }
  61. if (!$bFound)
  62.     {
  63.     push (@INC, ".");
  64.     }
  65. #
  66. # NT systems rarely execute the CGI scripts in the cgi-bin, so attempt to locate
  67. # the packages in that case.  This may still fail if the cgi-bin folder is named
  68. # something else, but at least we will catch 80% of the cases.  The INCLUDEPATHADJUSMENT
  69. # covers the remaining cases.
  70. #
  71. push (@INC, "cgi-bin");
  72. NETQUOTEVAR:INCLUDEPATHADJUSTMENT
  73.  
  74. require NETQUOTEVAR:ACTINICPACKAGE;
  75. require NETQUOTEVAR:ACTINICSAFER;
  76. require NETQUOTEVAR:ACTINICDIFFIE;
  77. require NETQUOTEVAR:ACTINICENCRYPT;
  78. require NETQUOTEVAR:ACTINICORDER;
  79. use strict;
  80.  
  81. #######################################################
  82. #                                                     #
  83. # CATALOG CUSTOMER ACCOUNTS CGI/PERL SCRIPT           #
  84. #                                                     #
  85. # Copyright (c) 1999 ACTINIC SOFTWARE LIMITED         #
  86. #                                                     #
  87. # written by Richard Zybert                           #
  88. #                                                     #
  89. #######################################################
  90.  
  91. $::prog_name = "CATACACC";                        # Program Name (8 characters)
  92. $::prog_ver = '$Revision: 16 $';                        # program version (6 characters)'
  93. $::prog_ver = substr($::prog_ver, 11);                    # strip the revision information
  94. $::prog_ver =~ s/ \$//;                            # and the trailers
  95.  
  96. Init();
  97. CAccDispatch();
  98. exit;
  99.  
  100. sub CAccDispatch
  101.     {
  102.     if( $::g_InputHash{ACTION} eq 'LOGOUT' )
  103.         {
  104.         CaccLogout();
  105.         }
  106.     ACTINIC::CAccLogin();
  107.     if( $::g_InputHash{PRODUCTPAGE} =~ /\S/ )
  108.         {
  109.         $ACTINIC::B2B->Set('ProductPage',$::g_InputHash{PRODUCTPAGE});
  110.         }
  111.     if( $ACTINIC::B2B->Get('ProductPage') )
  112.         {
  113.         $ACTINIC::B2B->Set('ProductFileCookie',ACTINIC::EncodeText2($ACTINIC::B2B->Get('ProductPage'), $::FALSE));
  114.         }
  115.     CAccPrintPage();
  116.     }
  117. sub CaccLogout
  118.     {
  119.     my $sHTML;
  120.     my ($sAccountCookie,$sBaseFile)   = ACTINIC::CaccGetCookies();
  121.     $sHTML = "<HTML><HEAD><META HTTP-EQUIV=\"refresh\" CONTENT=\"0; URL=".$sBaseFile."\"><BODY></BODY></HTML>";
  122.     $ACTINIC::B2B->Set('UserIDCookie',".");;
  123.     CAccPrintPageWithOptionalHighlight($sHTML, undef, $::FALSE);
  124.     exit;
  125.     }
  126.  
  127. #######################################################
  128. #                                                                        
  129. # CAccPrintPage - Print the HTML to the browser. 
  130. #
  131. # Params:    [0] - HTML
  132. #
  133. #######################################################
  134.  
  135. sub CAccPrintPage
  136.     {
  137.     my $sHTML = shift;
  138.     if( $sHTML )
  139.         {
  140.         CAccPrintPageWithOptionalHighlight($sHTML, undef, $::FALSE);
  141.         exit;
  142.         }
  143.     #
  144.     # Build the HTML, print and exit - don't return
  145.     #
  146.     my ($sProductPage,$sBodyPage);
  147.     if( $::g_InputHash{PRODUCTPAGE} =~ /\S/ )
  148.         {
  149.         $sProductPage = $::g_InputHash{PRODUCTPAGE};
  150.         }
  151.     else
  152.         {
  153.         ($sBodyPage,$sProductPage) = ACTINIC::CAccCatalogBody();
  154.         }
  155.     if( $::g_InputHash{MAINFRAMEURL} =~ /\S/ )
  156.         {
  157.         $sBodyPage = $::g_InputHash{MAINFRAMEURL};
  158.         }
  159.  
  160.     my ($sFirst,$sLast) = split("#",$sProductPage);                                     # isolate anchors
  161.  
  162.     my @Response = ACTINIC::TemplateFile(ACTINIC::GetPath() . $sFirst);    # make the substitutions
  163.     if ($Response[0] != $::SUCCESS)
  164.         {
  165.         return (@Response);
  166.         }
  167.     #
  168.     # clean up the links
  169.     #
  170.     my $sPath = $ACTINIC::B2B->Get('BaseFile');
  171.     if( $sLast ) { $sPath .= "#$sLast" }                                                # insert anchor back
  172.     my $sCgiUrl = $::g_sAccountScript;
  173.     $sCgiUrl   .= ($::g_InputHash{SHOP} ? '?SHOP=' . ACTINIC::EncodeText2($::g_InputHash{SHOP}, $::FALSE) . '&' : '?');
  174.     $sCgiUrl   .= "ACTINIC_REFERRER=" . ACTINIC::EncodeText2($::g_sAccountScript) . '&';
  175.     if( $sBodyPage and $sBodyPage ne $sProductPage )
  176.         {
  177.         $sCgiUrl .= "MAINFRAMEURL=$sBodyPage" . '&PRODUCTPAGE=';
  178.         }
  179.     else
  180.         {
  181.         $sCgiUrl .= "PRODUCTPAGE=";
  182.         }
  183.  
  184.     @Response = ACTINIC::MakeLinksAbsolute($Response[2], $sCgiUrl, $sPath);
  185.     if ($Response[0] != $::SUCCESS)
  186.         {
  187.         return (@Response);
  188.         }
  189.     $sHTML = $Response[2];
  190.     #
  191.     # Now do the XML tags and print
  192.     #
  193.     CAccPrintPageWithOptionalHighlight($sHTML, undef, $::FALSE);
  194.     exit;
  195.     }
  196.  
  197. #######################################################
  198. #                                                                        
  199. # CAccPrintPageWithOptionalHighlight - print the page
  200. #   If the search script arguments are in place, do
  201. #   the search script highlighting before print.
  202. #
  203. #  Input:     0 - HTML to print
  204. #             1 - cookie
  205. #             2 - HTTP header cache status
  206. #                 ($::TRUE = no cache)
  207. #
  208. #  Expects:   %::g_InputHash to contain the CGI params
  209. #             $::g_pSearchSetup blob with search config
  210. #                hash
  211. #
  212. #######################################################
  213.  
  214. sub CAccPrintPageWithOptionalHighlight
  215.     {
  216. #? ACTINIC::ASSERT($#_ == 2, "Incorrect parameter count CAccPrintPageWithOptionalHighlight(" . join(', ', @_) . ").", __LINE__, __FILE__);
  217.     my ($sHTML, $sCookie, $bNoCache) = @_;
  218.     #
  219.     # See if we are to highlight anything
  220.     #
  221.     my $sWords = $::g_InputHash{WD};                    # retrieve the words to highlight
  222.     if ($sWords)
  223.         {
  224.         ACTINIC::HighlightWords($sWords, $$::g_pSearchSetup{SEARCH_HIGHLIGHT_START}, $$::g_pSearchSetup{SEARCH_HIGHLIGHT_END}, \$sHTML);
  225.         }
  226.  
  227.     ACTINIC::PrintPage($sHTML, $sCookie, $bNoCache);
  228.     }
  229.  
  230. #######################################################
  231. #                                                                        
  232. # Init - initialize the script
  233. #
  234. #######################################################
  235.  
  236. sub Init
  237.     {
  238.     $::g_bFirstError = $::TRUE;                        # this flag indicates that the display page method has entered recursion
  239.                                                                 # due to errors - it prevents infinite recursion
  240.     my (@Response, $Status, $Message);
  241.     
  242.     @Response = ReadAndParseInput();                    # read the input from the CGI call
  243.     ($Status, $Message) = @Response;    # parse the response
  244.     if ($Status != $::SUCCESS)
  245.         {
  246.         ACTINIC::ReportError($Message, ACTINIC::GetPath());
  247.         }
  248.         
  249.     @Response = ReadAndParseBlobs();                    # read the catalog blobs
  250.     ($Status, $Message) = @Response;                    # parse the response
  251.     if ($Status != $::SUCCESS)
  252.         {
  253.         ACTINIC::ReportError($Message, ACTINIC::GetPath());
  254.         }
  255.     }
  256.  
  257. #######################################################
  258. #                                                                        
  259. # ReadAndParseInput - read the input and parse it
  260. #
  261. # Expects:    $ENV to be defined
  262. #
  263. # Affects:    @::g_PageList - global list of pages visited
  264. #
  265. # Returns:    ($ReturnCode, $Error)
  266. #                if $ReturnCode = $FAILURE, the operation failed
  267. #                    for the reason specified in $Error
  268. #                Otherwise everything is OK
  269. #
  270. #######################################################
  271.  
  272. sub ReadAndParseInput
  273.     {
  274.     my ($status, $message, $temp);
  275.     ($status, $message, $::g_OriginalInputData, $temp, %::g_InputHash) = ACTINIC::ReadAndParseInput();
  276.     if ($status != $::SUCCESS)
  277.         {
  278.         return ($status, $message, 0, 0);
  279.         }
  280.     #
  281.     # parse the ref page list
  282.     #
  283.     ($status, $message, @::g_PageList) = ACTINIC::ProcessReferencePageData(%::g_InputHash);
  284.     if ($status != $::SUCCESS)
  285.         {
  286.         return ($status, $message, 0, 0);
  287.         }
  288.  
  289.     #######
  290.     # retrieve the web site url
  291.     #######
  292.     ($status, $message, $::g_sWebSiteUrl, $::g_sContentUrl) = ACTINIC::GetWebSiteURL(@::g_PageList);
  293.     if ($status != $::SUCCESS)
  294.         {
  295.         return ($status, $message, 0, 0);
  296.         }
  297.     
  298.     return ($::SUCCESS, "", 0, 0);
  299.     }
  300.  
  301.  
  302. #######################################################
  303. #                                                                        
  304. # ReadAndParseBlobs - read the blobs and store them
  305. #    in global data structures
  306. #
  307. # Expects:    %::g_InputHash - the input hash table should
  308. #                    be defined
  309. #
  310. # Affects:    $g_sCartId - the cart ID for this customer
  311. #                %g_BillContact - the invoice contact information
  312. #                %g_ShipContact - the delivery contact information
  313. #                %g_ShipInfo - the shipping information
  314. #                %g_TaxInfo - the tax information
  315. #                %g_GeneralInfo - general information
  316. #                %g_PaymentInfo - payment information
  317. #
  318. # Returns:    ($ReturnCode, $Error)
  319. #                if $ReturnCode = $FAILURE, the operation failed
  320. #                    for the reason specified in $Error
  321. #                Otherwise everything is OK
  322. #
  323. #######################################################
  324.  
  325. sub ReadAndParseBlobs
  326.     {
  327.     my ($Status, $Message, @Response, $sPath);
  328.  
  329.     $sPath = ACTINIC::GetPath();                        # get the path to the web site
  330.  
  331.     @Response = ACTINIC::ReadCatalogFile($sPath); # read the catalog blob
  332.     ($Status, $Message) = @Response;                    # parse the response
  333.     if ($Status != $::SUCCESS)                            # on error, bail
  334.         {
  335.         return (@Response);
  336.         }
  337.         
  338.     @Response = ACTINIC::ReadSetupFile($sPath);    # read the setup
  339.     ($Status, $Message) = @Response;
  340.     if ($Status != $::SUCCESS)
  341.         {
  342.         return (@Response);
  343.         }
  344.         
  345.     @Response = ACTINIC::ReadLocationsFile($sPath);    # read the locations
  346.     ($Status, $Message) = @Response;
  347.     if ($Status != $::SUCCESS)
  348.         {
  349.         return (@Response);
  350.         }
  351.     #
  352.     # read the phase blob
  353.     #
  354.     @Response = ACTINIC::ReadPhaseFile($sPath);
  355.     if ($Response[0] != $::SUCCESS)
  356.         {
  357.         return (@Response);
  358.         }    
  359.     #
  360.     # read the prompt blob
  361.     #
  362.     @Response = ACTINIC::ReadPromptFile($sPath);
  363.     if ($Response[0] != $::SUCCESS)
  364.         {
  365.         return (@Response);
  366.         }
  367.     #
  368.     # read the tax blob
  369.     #
  370.     @Response = ACTINIC::ReadTaxSetupFile($sPath);
  371.     if ($Response[0] != $::SUCCESS)
  372.         {
  373.         return (@Response);
  374.         }
  375.     #
  376.     # read the tax blob
  377.     #
  378.     @Response = ACTINIC::ReadSearchSetupFile($sPath);
  379.     if ($Response[0] != $::SUCCESS)
  380.         {
  381.         return (@Response);
  382.         }
  383.     #
  384.     # read the cart ID
  385.     #
  386.     @Response = ActinicOrder::GetCartID(ACTINIC::GetPath()); # retrieve the cart ID
  387.     ($Status, $Message, $::g_sCartId) = @Response;
  388.     if ($Status != $::SUCCESS)                            # error out
  389.         {
  390.         return (@Response);
  391.         }
  392.     
  393.     #
  394.     # read the checkout status
  395.     #
  396.     my ($pBillContact, $pShipContact, $pShipInfo, $pTaxInfo, $pGeneralInfo, $pPaymentInfo, $pLocationInfo);
  397.     @Response = ActinicOrder::RetrieveCheckoutStatus($sPath, $::g_sCartId);
  398.     if ($Response[0] != $::SUCCESS)
  399.         {
  400.         return (@Response);
  401.         }
  402.     ($Status, $Message, $pBillContact, $pShipContact, $pShipInfo, $pTaxInfo, $pGeneralInfo, $pPaymentInfo, $pLocationInfo) = @Response;
  403.     %::g_BillContact = %$pBillContact;                    # copy the hashes to global tables
  404.     %::g_ShipContact = %$pShipContact;
  405.     %::g_ShipInfo        = %$pShipInfo;
  406.     %::g_TaxInfo        = %$pTaxInfo;
  407.     %::g_GeneralInfo = %$pGeneralInfo;
  408.     %::g_PaymentInfo = %$pPaymentInfo;
  409.     %::g_LocationInfo = %$pLocationInfo;
  410.  
  411.     return ($::SUCCESS, "", 0, 0);
  412.     }
  413.  
  414.